home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 007a / 899track.zip / 899GPRED.PRO < prev    next >
Text File  |  1990-03-06  |  6KB  |  217 lines
  1. project "899"
  2. include "899glob.pro"
  3.  
  4. % 899GPRED.PRO -- Global Miscelaneous Predicate-clauses
  5. % GLOBAL PREDICATES IN THIS FILE::
  6. %        getMusicTypes
  7. %        getLabelNames
  8. %        repeat
  9. %        getIntOpt
  10. %        showerr
  11. %        message
  12. %        askyn
  13. %        bep
  14. %        inverse
  15. %        wait
  16. %        up_case
  17. %        readKey
  18. %        getKey
  19. %        change_window_title
  20. %        getCorrelating
  21. %        listlen
  22. %        maxlen
  23. %        modifdat
  24. %        expgsList
  25. %        sameMusicCategory
  26. %        writeToEol
  27. %        writelist
  28. %        writespaces
  29.  
  30. DATABASE - correlator
  31.   determ namelist(gsList)
  32.  
  33. PREDICATES
  34.   key_code(key,CHAR,INTEGER)
  35.   key_code2(key,INTEGER)
  36.   memberK(key,keylist)
  37.   gtIntC2(INTEGER,INTEGER,INTEGER,INTEGER,INTEGER)
  38.   wel(INTEGER,INTEGER,CHAR)
  39.   stopwatch(INTEGER)
  40.   cnt(INTEGER,INTEGER,INTEGER)
  41.   match(gs)      % Used by correlator
  42.  
  43. CLAUSES
  44.   repeat.
  45.   repeat :- repeat.
  46.   
  47.   getMusicTypes(CurrentlyDefinedMusicTypes) :-
  48.       findall(Music,category(Music),CurrentlyDefinedMusicTypes).
  49.  
  50.   getLabelNames(FullListOfNames) :-
  51.       findall(Nms,label(_,Nms,_,_,_,_,_,_),FullListOfNames).
  52.  
  53.   wait :- write("Press Enter to Continue\n"),
  54.           getkey(_,[cr]).
  55.  
  56.   up_case(InChar,Outchar) :-
  57.     str_char(InString,InChar),
  58.     upper_lower(InStrUp,InString),
  59.     str_char(InStrUp,OutChar).
  60.  
  61.   getkey(Retkey,ValidList) :-  /* We do fun things */
  62.     getbacktrack(Btop),
  63.     repeat,                    /* do the follwing */
  64.       readkey(K),              /* 1) get a keypress and see what it is */
  65.       memberK(K,ValidList), !, /* 2) see if it is in the list of valid keys */
  66.     cutbacktrack(Btop),
  67.     Retkey=K.                  /* If so, then return the key otherwise above will loop */
  68.  
  69.   memberK(Object,[Object|_]) :- !.                   /* Memer of key if is the head */
  70.   memberK(Object,[_|Tail]) :- memberK(Object,Tail).  /* Or in the tail */
  71.  
  72.   sameMusicCategory(SomeType,[SomeType|_]) :- !.
  73.   sameMusicCategory(SomeType,[_|RestOfList]) :- sameMusicCategory(SomeType,RestOfList).
  74.  
  75.   readkey(K):- readchar(T), char_int(T,Val), key_code(K,T,Val).
  76.  
  77.   key_code(K,_,0):- readchar(T), char_int(T,Val), key_code2(K,Val),!.
  78.   key_code(break,_,3)  :-!.     key_code(bdel,_,8):-!.
  79.   key_code(tab,_,10)   :-!.     key_code(cr,_,13) :-!.
  80.   key_code(esc,_,27)   :-!.
  81.   key_code(num(N),_,S) :-S>=$30, S<=$39, N=S-$30, !.
  82.   key_code(char(T),T,_).
  83.   
  84.   key_code2(btab,15)   :-!.     key_code2(home,71):-!.
  85.   key_code2(up,72)     :-!.     key_code2(left,75):-!.
  86.   key_code2(right,77)  :-!.     key_code2(end,79) :-!.
  87.   key_code2(down,80)   :-!.     key_code2(ins,82) :-!.
  88.   key_code2(del,83)    :-!.     key_code2(pgup,73):-!.
  89.   key_code2(pgdn,81)   :-!.
  90.   key_code2(fkey(N),V) :-V>58, V<70, N=V-58, !.
  91.   key_code2(other,_).
  92.  
  93.   change_window_title(NewTitle) :- % Changes the title on currently active window
  94.     makewindow(_,_,FrameAtt,_,_,_,_,_,_,Placement,BorderDef), % Get some of this
  95.     framewindow(FrameAtt,NewTitle,PlaceMent,BorderDef).
  96.  
  97.   inverse(A1,A2):-
  98.     bitand(A1,$07,H11),
  99.     bitleft(H11,4,H12),
  100.     bitand(A1,$70,H21),
  101.     bitright(H21,4,H22),
  102.     bitand(A1,$08,H31),
  103.     A2=H12+H22+H31.
  104.  
  105.   getIntOpt(Min,Max,Choice) :-
  106.     getbacktrack(Btop),
  107.     write("Please choose an option (",Min,'-',Max,") --> "),
  108.     cursor(CurrX,CurrY), % Get coords
  109.     repeat,
  110.       cursor(CurrX,CurrY),
  111.       writeToEol(' '),
  112.       cursor(CurrX,CurrY),
  113.       readint(X),
  114.       cursor(CurrX,CurrY),
  115.     gtIntC2(Min,Max,X,CurrX,CurrY),
  116.     cutbacktrack(Btop),
  117.     Choice = X.
  118.  
  119.   gtIntC2(Min,Max,X,_,_) :-
  120.     X >= Min, X <= Max, !.
  121.   gtIntC2(_,_,_,CurrX,CurrY) :-
  122.     cursor(CurrX,CurrY),
  123.     writeToEol(' '),
  124.     fail.
  125.  
  126.   writeToEol(DataChar) :-
  127.     makewindow(_,_,_,_,_,_,_,MaxY),
  128.     LastPlace = MaxY - 2,
  129.     cursor(CurrX,CurrY),
  130.     getbacktrack(Btop),
  131.     wel(CurrY,LastPlace,DataChar),
  132.     cutbacktrack(Btop),
  133.     cursor(CurrX,CurrY).
  134.  
  135.   wel(X,X,Q) :- !, write(Q).
  136.   wel(C,M,D) :- write(D), Nn = C + 1, wel(Nn,M,D).
  137.  
  138.   showerr(Ps) :-
  139.     makewindow(105,79,0,"",22,0,2,80),
  140.     write(Ps), nl,
  141.     wait,
  142.     removewindow.
  143.  
  144.   message(Ps) :-
  145.     Attr = b_blue + yellow,
  146.     makewindow(105,Attr,0,"",22,0,2,80),
  147.     write(Ps),
  148.     stopwatch(100),
  149.     removewindow.
  150.  
  151.   stopwatch(TimeDelay) :-
  152.     cnt(TimeDelay,1000,0).
  153.   
  154.   cnt(0,1000,1000) :- !.
  155.   cnt(X,N,N) :- !, NewX = X - 1, cnt(NewX,1000,0).
  156.   cnt(X,N,F) :- NewF = F + 1, cnt(X,N,NewF).
  157.  
  158.   askyn :-    /* Get's user's reponse (Y/N) and fails on anything except Y or y */
  159.       readln(Response),
  160.       frontchar(Response,RsChar,_),
  161.       up_case(RsChar,UsrChar),
  162.       UsrChar = 'Y', !.
  163.  
  164.   bep :- sound(5,1300), sound(10,300), sound(15,165).
  165.  
  166.   getCorrelating(SomeGivenMusicType,ListOfQualifiedNames) :-
  167.       getbacktrack(Btop),
  168.       assert(namelist([]),correlator),
  169.       match(SomeGivenMusicType),
  170.       retract(namelist(ListOfQualifiedNames),correlator),
  171.       cutbacktrack(Btop).
  172.   
  173.   match(GivenMusicType) :-
  174.       label(TypesForThisContact,ContactName,_,_,_,_,_,_),
  175.         getbacktrack(Btop),
  176.         sameMusicCategory(GivenMusicType,TypesForThisContact), % If this succeds
  177.         retract(namelist(CurrList),correlator),
  178.         NewList = [ContactName | CurrList],
  179.         assert(namelist(NewList),correlator),
  180.         cutbacktrack(Btop),
  181.       fail.
  182.   match(_).
  183.  
  184.   maxlen([H|T],MAX,MAX1) :-
  185.     str_len(H,LENGTH),
  186.     LENGTH>MAX,!,
  187.     maxlen(T,LENGTH,MAX1).
  188.   maxlen([_|T],MAX,MAX1) :- maxlen(T,MAX,MAX1).
  189.   maxlen([],LENGTH,LENGTH).
  190.  
  191.   listlen([],0).
  192.   listlen([_|T],N):-
  193.     listlen(T,X),
  194.     N=X+1.
  195.  
  196.   expgsList(TargetDelete,[TargetDelete|RestOfList],RestOfList) :- !.
  197.   expgsList(TargetDelete,[ItemBeforeDeletedItem|RestOfList],NewList) :-
  198.     expgsList(TargetDelete,RestOfList,ListOfItemsAfterDeletedItem),
  199.     NewList = [ItemBeforeDeletedItem | ListOfItemsAfterDeletedItem]. % Exclude deleted item
  200.  
  201.   modifdat :-
  202.       retract(datamodified),
  203.       fail.
  204.   modifdat :-
  205.       assert(datamodified).
  206.  
  207.   writespaces(0) :- !.
  208.   writespaces(N) :- write(' '), Nn = N - 1, writespaces(Nn).
  209.  
  210.   writelist([],_) :- !.
  211.   writelist([Curr|Next],IndentFactor) :-
  212.       Curr <> "", !,
  213.       writespaces(Indentfactor),
  214.       write(Curr), nl,
  215.       writelist(Next,IndentFactor).
  216.   writelist([_|Next],IndentFactor) :- writelist(Next,IndentFactor).  % Skip Null strings
  217.